home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / ISSUE14 / FORMCOMP / NEWFORMS.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1996-09-07  |  4.7 KB  |  169 lines

  1. unit NewForms;
  2. {$R-,S-,I-,O-,F-,A+,U+,K+,W-,V+,B-,X+,T-,P+,L+,Y+,D-}
  3.  
  4. interface
  5.  
  6. uses
  7.   WinTypes, WinProcs, Messages, Controls, Classes, Forms;
  8.  
  9. type
  10.   TNewForm = class(TForm)
  11.     constructor Create (AOwner : TComponent); override;
  12.     procedure CreateParams (var Params : TCreateParams); override;
  13.     procedure FormKeyPress(Sender: TObject; var Key: Char); virtual;
  14.     procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); virtual;
  15.     procedure FormClose(Sender: TObject; var Action: TCloseAction); virtual;
  16.   private
  17.     { Private declarations }
  18.     procedure WMGetMinMaxInfo( var Message :TWMGetMinMaxInfo ); message
  19.     WM_GETMINMAXINFO;
  20.   public
  21.     { Public declarations }
  22.     Set_Enter  : Boolean; { Set to convert CR to TAB }
  23.     Set_Max    : Boolean; { Set and init following to fix max size }
  24.     Max_Width,
  25.     Max_Height : Word;
  26.     Set_Min    : Boolean; { Set and init following to fix min size }
  27.     Min_Width,
  28.     Min_Height : Word;
  29.     Set_Pos    : Boolean; { Set and init following to fix posn }
  30.     Max_Left,
  31.     Max_Top    : Word;
  32.     OldOnkeyPress : TKeyPressEvent;
  33.     OldOnkeyDown  : TKeyEvent;
  34.     OldOnClose    : TCloseEvent;
  35.     FormVar       : ^TForm;  { set by Launch }
  36.   end;
  37.  
  38. type
  39.   TFormClass = class of TNewForm;
  40.   TFormPtr   = ^TNewForm;
  41.  
  42. { Launch a form if not already open , else un-minimise and bring to front }
  43. procedure Launch (LClass : TFormClass; var LForm);
  44.  
  45. implementation
  46.  
  47. constructor TNewForm.Create (AOwner : TComponent);
  48. begin
  49.   inherited Create (AOwner);
  50.  
  51.   if Set_Enter
  52.   then begin
  53.        OldOnKeyPress := OnKeyPress;
  54.        OnKeyPress    := FormKeyPress;
  55.        OldOnKeyDown  := OnKeyDown;
  56.        OnKeyDown     := FormKeyDown;
  57.        KeyPreview    := TRUE;
  58.   end;
  59.  
  60.   OldOnClose := OnClose;
  61.   OnClose    := FormClose;
  62. end;
  63.  
  64. procedure TNewForm.CreateParams (var Params : TCreateParams);
  65. begin
  66.   if Set_Max
  67.   then begin
  68.        Params.Width   := Max_Width;
  69.        Params.Height  := Max_Height;
  70.   end;
  71.   inherited CreateParams (Params);
  72. end;
  73.  
  74. procedure TNewForm.FormKeyPress(Sender: TObject; var Key: Char);
  75. begin
  76.   case Key of
  77.        #13 : begin
  78.                   PostMessage(Handle, WM_NEXTDLGCTL, 0, 0);
  79.                   {SelectNext ( ActiveControl as tWinControl, True, True );}
  80.                   Key := #0;
  81.              end;
  82.        else  begin
  83.                   if assigned (OldOnKeyPress)
  84.                   then OldOnKeyPress (Sender, Key);
  85.              end;
  86.   end;
  87. end;
  88.  
  89. procedure TNewForm.FormKeyDown(Sender: TObject; var Key: Word;
  90.   Shift: TShiftState);
  91. begin
  92.   case Key of
  93.        Vk_Return : Key := Vk_Tab;
  94.        else  begin
  95.                   if assigned (OldOnKeyDown)
  96.                   then OldOnKeyDown (Sender, Key, Shift);
  97.              end;
  98.   end;
  99. end;
  100.  
  101. procedure TNewForm.FormClose(Sender: TObject; var Action: TCloseAction);
  102. begin
  103.   Application.OnHint := nil;
  104.   if FormStyle = fsMdiChild
  105.   then Action := caFree;
  106.   if assigned (OldOnClose)
  107.   then OldOnClose (Sender,Action);
  108.   if assigned (FormVar)
  109.   then FormVar^ := nil;
  110. end;
  111.  
  112. procedure TNewForm.WMGetMinMaxInfo (var Message :TWMGetMinMaxInfo);
  113. begin
  114.   with Message.MinMaxInfo^ do
  115.   begin
  116.     if Set_Max
  117.     then begin
  118.          if Max_Width <> 0
  119.          then ptMaxSize.X      := Max_Width;  {Width when maximized.}
  120.          if Max_Height <> 0
  121.          then ptMaxSize.Y      := Max_Height; {Height when maximized.}
  122.          Message.Result   := 0; {Tell windows you have changed minmaxinfo.}
  123.     end;
  124.     if Set_Pos
  125.     then begin
  126.          if Max_Left <> 0
  127.          then ptMaxPosition.X  := Max_Left;  {Left position when maximized.}
  128.          if Max_Top <> 0
  129.          then ptMaxPosition.Y  := Max_Top;   {Top position when maximized.}
  130.          Message.Result   := 0; {Tell windows you have changed minmaxinfo.}
  131.     end;
  132.     if Set_Min
  133.     then begin
  134.          if Min_Width <> 0
  135.          then ptMinTrackSize.X := Min_Width; {Minimum width.}
  136.          if Min_Height <> 0
  137.          then ptMinTrackSize.Y := Min_Height;{Minimum height.}
  138.          Message.Result   := 0; {Tell windows you have changed minmaxinfo.}
  139.     end;
  140.     if Set_Max
  141.     then begin
  142.          if Max_Width <> 0
  143.          then ptMaxTrackSize.X := Max_Width; {Maximum width.}
  144.          if Max_Height <> 0
  145.          then ptMaxTrackSize.Y := Max_Height;{Maximum height.}
  146.     end;
  147.   end;
  148.   inherited;
  149. end;
  150.  
  151. procedure Launch (LClass : TFormClass; var LForm);
  152. var
  153.    LNewForm : TNewForm absolute LForm;
  154. begin
  155.   if LNewForm = nil
  156.   then begin
  157.        Application.CreateForm (LClass,LNewForm);
  158.        LNewForm.FormVar := @LNewForm;
  159.   end
  160.   else with LNewForm
  161.        do begin
  162.           BringToFront;
  163.           If WindowState = wsMinimized
  164.           then WindowState := wsNormal;
  165.        end;
  166. end;
  167.  
  168. end.
  169.